home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / editpat.lha / DisplayPat.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-12-01  |  11.7 KB  |  415 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. FoldElems
  5. MODULE DisplayPat; (* V0.6 (C) 4 Nov 94 by Ralf Degner *)
  6.     IMPORT
  7.         Display, Files, Texts, TextFrames, Oberon, Fonts;
  8.     CONST
  9.         OriCol*=-1;
  10.     TYPE
  11.         PatData = POINTER TO PatDataDesc;
  12.         PatDataDesc = RECORD
  13.             Next: PatData;
  14.             Data: POINTER TO ARRAY OF SET;
  15.         END;
  16.         OnePat = POINTER TO OnePatDesc;
  17.         OnePatDesc = RECORD
  18.             Color: INTEGER;
  19.             Pat: Display.Pattern;
  20.             Next: OnePat;
  21.         END;
  22.         Pattern = POINTER TO PatternDesc;
  23.         PatternDesc = RECORD (OnePatDesc)
  24.             W, H: INTEGER;
  25.         END;
  26.         (* the AMIGA needs the text in italic, because of if it is not there         *)
  27.         (* the garbage collectore kills the POINTERs in the open ARRAY          *)
  28.         (* ignore the warning, the compiler shows at the AMIGA (and Sun ?)    *)
  29.         AmigaTyp = POINTER TO AmigaTypDesc;
  30.         AmigaTypDesc = RECORD
  31.             Next: AmigaTyp;
  32.             Pat: Pattern;
  33.         END;
  34.         Object*= POINTER TO ObjectDesc;
  35.         ObjectDesc*= RECORD (PatDataDesc)
  36.             FirstPatData: PatData;
  37.             MaxPat: LONGINT;
  38.             ColorMap*: ARRAY 256 OF INTEGER;
  39.             Pats: POINTER TO ARRAY OF Pattern;
  40.             ErrorMsg: BOOLEAN;
  41.             Amiga: AmigaTyp;
  42.         END;
  43.         W: Texts.Writer;
  44.         SetArray: ARRAY 8 OF SHORTINT;
  45.     (* write SET in a portable way *)
  46.     PROCEDURE WriteSet*(VAR R: Files.Rider; x: SET);
  47.         VAR
  48.             DumByte, DumBit, Count: INTEGER;
  49.             Dummy: SHORTINT;
  50.     BEGIN
  51.         Count:=0;
  52.         FOR DumByte:=0 TO 3 DO
  53.             Dummy:=0;
  54.             FOR DumBit:=0 TO 7 DO
  55.                 IF Count IN x THEN
  56.                     Dummy:=Dummy+SetArray[DumBit];
  57.                 END;
  58.                 INC(Count);
  59.             END;
  60.             Files.Write(R, Dummy);
  61.         END;
  62.     END WriteSet;
  63.     (* read SET in a portable way *)
  64.     PROCEDURE ReadSet*(VAR R: Files.Rider; VAR x: SET);
  65.         VAR
  66.             DumByte, DumBit, Count: INTEGER;
  67.             Dummy: SHORTINT;
  68.     BEGIN
  69.         x:={};Count:=0;
  70.         FOR DumByte:=0 TO 3 DO
  71.             Files.Read(R, Dummy);
  72.             FOR DumBit:=0 TO 7 DO
  73.                 IF (Dummy MOD 2)=1 THEN
  74.                     INCL(x, Count);
  75.                 END;
  76.                 Dummy:=Dummy DIV 2;
  77.                 INC(Count);
  78.             END;
  79.         END;
  80.     END ReadSet;
  81.     (* print errormessage, if ErrorMsg is TRUE *)
  82.     PROCEDURE (o: Object) Print(Text: ARRAY OF CHAR);
  83.     BEGIN
  84.         IF o.ErrorMsg THEN
  85.             Texts.WriteString(W, "DisplayPat error: ");
  86.             Texts.WriteString(W, Text);
  87.             Texts.WriteLn(W);
  88.             Texts.Append(Oberon.Log, W.buf);
  89.         END;
  90.     END Print;
  91.     (* install an object from diskfile *)
  92.     PROCEDURE (o: Object) Install*(Name: ARRAY OF CHAR; Msg: BOOLEAN);
  93.         VAR
  94.             File: Files.File;
  95.             Rider: Files.Rider;
  96.             LDum, PatAnz, Counter: LONGINT;
  97.             RealW, DPW, W, H, Color, LastColor, Dummy: INTEGER;
  98.             LastOne, DumOne: OnePat;
  99.             LastData, DumData: PatData;
  100.             LastAmiga, DumAmiga: AmigaTyp;
  101.     BEGIN
  102.         o.ErrorMsg:=Msg;
  103.         o.Pats:=NIL;
  104.         o.FirstPatData:=NIL;
  105.         o.MaxPat:=0;
  106.             NEW(o.Amiga);
  107.             o.Amiga.Next:=NIL;
  108.             o.Amiga.Pat:=NIL;
  109.             LastAmiga:=o.Amiga;
  110.         File:=Files.Old(Name);
  111.         IF File=NIL THEN
  112.             o.Print("Can`t open Pat-File");
  113.             RETURN;
  114.         END;
  115.         Files.Set(Rider, File, 0);
  116.         Files.ReadLInt(Rider, LDum);
  117.         IF LDum#26021970 THEN
  118.             o.Print("File is not a Pat-File");
  119.             RETURN;
  120.         END;
  121.         Files.ReadLInt(Rider, PatAnz);
  122.         o.MaxPat:=PatAnz;
  123.         NEW(o.Pats, PatAnz);
  124.         Counter:=0;
  125.         LastData:=o;
  126.         WHILE PatAnz#Counter DO
  127.             NEW(o.Pats[Counter]);
  128.             Files.ReadInt(Rider, W);o.Pats[Counter].W:=W;
  129.             Files.ReadInt(Rider, H);o.Pats[Counter].H:=H;
  130.             LastOne:=o.Pats[Counter];
  131.                 NEW(DumAmiga);DumAmiga.Next:=NIL;
  132.                 LastAmiga.Next:=DumAmiga;
  133.                 DumAmiga.Pat:=o.Pats[Counter];
  134.                 LastAmiga:=DumAmiga;
  135.             Files.ReadInt(Rider, Color);
  136.             LastColor:=-1;
  137.             WHILE Color#-1 DO
  138.                 IF Color#LastColor THEN
  139.                     DPW:=0;
  140.                 END;
  141.                 LastColor:=Color;
  142.                 NEW(DumOne);DumOne.Next:=NIL;
  143.                 NEW(DumData);DumData.Next:=NIL;
  144.                 NEW(DumData.Data, H+1);
  145.                 DumOne.Color:=Color;
  146.                 FOR Dummy:=1 TO H DO
  147.                     ReadSet(Rider, DumData.Data[Dummy]);
  148.                 END;
  149.                 RealW:=32;
  150.                 IF DPW+32>W THEN
  151.                     RealW:=W-DPW;
  152.                 END;
  153.                 DumOne.Pat:=Display.NewPattern(DumData.Data^, RealW, H);
  154.                 LastOne.Next:=DumOne;
  155.                 LastOne:=DumOne;
  156.                 LastData.Next:=DumData;
  157.                 LastData:=DumData;
  158.                 Files.ReadInt(Rider, Color);
  159.                 INC(DPW, 32);
  160.             END;
  161.             INC(Counter);
  162.         END;
  163.         FOR Dummy:=0 TO 255 DO
  164.             o.ColorMap[Dummy]:=Dummy;
  165.         END;
  166.         Files.Close(File);
  167.     END Install;
  168.     (* get width and height of a pattern *)
  169.     PROCEDURE (o: Object) GetPatternSize*(PatNr: LONGINT; VAR w, h: INTEGER);
  170.     BEGIN
  171.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  172.             o.Print("Unkown Pattern number");
  173.             w:=0;h:=0;
  174.         ELSE
  175.             w:=o.Pats[PatNr].W;
  176.             h:=o.Pats[PatNr].H;
  177.         END;
  178.     END GetPatternSize;
  179.     (* get the Display.Pattern of a Pattern with number PatNr *)
  180.     PROCEDURE (o: Object) GetPattern*(PatNr: INTEGER): Display.Pattern;
  181.         VAR DumOnePat: OnePat;
  182.     BEGIN
  183.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  184.             o.Print("Unkown Pattern number");
  185.         ELSE
  186.             DumOnePat:=o.Pats[PatNr];
  187.             IF DumOnePat.Next#NIL THEN
  188.                 IF DumOnePat.Next.Next=NIL THEN
  189.                     RETURN DumOnePat.Next.Pat;
  190.                 ELSE
  191.                     o.Print("Can`t get Pattern with more than 1 Color or width larger than 32");
  192.                 END;
  193.             ELSE
  194.                 o.Print("Can`t get Pattern of empty one");
  195.             END;
  196.         END;
  197.         RETURN 0;
  198.     END GetPattern;
  199.     PROCEDURE (o: Object) CopyPatternC*(f: Display.Frame; col: INTEGER; PatNr: LONGINT; X, Y, mode: INTEGER);
  200.         VAR
  201.             LastColor, Offset: INTEGER;
  202.             PatInfo: OnePat;
  203.     BEGIN
  204.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  205.             o.Print("Unkown Pattern number");
  206.         ELSE
  207.             PatInfo:=o.Pats[PatNr];
  208.             LastColor:=PatInfo.Next.Color;
  209.             Offset:=-32;
  210.             WHILE PatInfo.Next#NIL DO
  211.                 PatInfo:=PatInfo.Next;
  212.                 IF PatInfo.Color=LastColor THEN
  213.                     INC(Offset, 32);
  214.                 ELSE
  215.                     LastColor:=PatInfo.Color;
  216.                     IF mode=Display.replace THEN mode:=Display.paint;END;
  217.                     Offset:=0;
  218.                 END;
  219.                 IF col=OriCol THEN
  220.                     Display.CopyPatternC(f, o.ColorMap[PatInfo.Color], PatInfo.Pat, X+Offset, Y, mode);
  221.                 ELSE
  222.                     Display.CopyPatternC(f, col, PatInfo.Pat, X+Offset, Y, mode);
  223.                 END;
  224.             END;
  225.         END;
  226.     END CopyPatternC;
  227.     PROCEDURE (o: Object) CopyPattern*(col: INTEGER; PatNr: LONGINT; X, Y, mode: INTEGER);
  228.         VAR
  229.             LastColor, Offset: INTEGER;
  230.             PatInfo: OnePat;
  231.     BEGIN
  232.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  233.             o.Print("Unkown Pattern number");
  234.             RETURN
  235.         END;
  236.         PatInfo:=o.Pats[PatNr];
  237.         LastColor:=PatInfo.Next.Color;
  238.         Offset:=-32;
  239.         WHILE PatInfo.Next#NIL DO
  240.             PatInfo:=PatInfo.Next;
  241.             IF PatInfo.Color=LastColor THEN
  242.                 INC(Offset, 32);
  243.             ELSE
  244.                 LastColor:=PatInfo.Color;
  245.                 IF mode=Display.replace THEN mode:=Display.paint;END;
  246.                 Offset:=0;
  247.             END;
  248.             IF col=OriCol THEN
  249.                 Display.CopyPattern(o.ColorMap[PatInfo.Color], PatInfo.Pat, X+Offset, Y, mode);
  250.             ELSE
  251.                 Display.CopyPattern(col, PatInfo.Pat, X+Offset, Y, mode);
  252.             END;
  253.         END;
  254.     END CopyPattern;
  255.     PROCEDURE (o: Object) ReplPatternC*(f: Display.Frame; col: INTEGER; PatNr: LONGINT; X, Y, W, H, X0, Y0, mode: INTEGER);
  256.         VAR
  257.             LastColor, Offset: INTEGER;
  258.             PatInfo: OnePat;
  259.     BEGIN
  260.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  261.             o.Print("Unkown Pattern number");
  262.             RETURN
  263.         END;
  264.         PatInfo:=o.Pats[PatNr];
  265.         IF o.Pats[PatNr].W<33 THEN
  266.             LastColor:=PatInfo.Next.Color;
  267.             Offset:=-32;
  268.             WHILE PatInfo.Next#NIL DO
  269.                 PatInfo:=PatInfo.Next;
  270.                 IF PatInfo.Color=LastColor THEN
  271.                     INC(Offset, 32);
  272.                 ELSE
  273.                     LastColor:=PatInfo.Color;
  274.                     IF mode=Display.replace THEN mode:=Display.paint;END;
  275.                     Offset:=0;
  276.                 END;
  277.                 IF col=OriCol THEN
  278.                     Display.ReplPatternC(f, o.ColorMap[PatInfo.Color], PatInfo.Pat, X+Offset, Y, W, H, X0, Y0, mode);
  279.                 ELSE
  280.                     Display.ReplPatternC(f, col, PatInfo.Pat, X+Offset, Y, W, H, X0, Y0, mode);
  281.                 END;
  282.             END;
  283.         ELSE
  284.             o.Print("ReplPatternC can display only pattern with width <=32");
  285.             o.Print("use ReplPatternN instead");
  286.         END;
  287.     END ReplPatternC;
  288.     PROCEDURE (o: Object) ReplPattern*(col: INTEGER; PatNr: LONGINT; X, Y, W, H, mode: INTEGER);
  289.         VAR
  290.             LastColor, Offset: INTEGER;
  291.             PatInfo: OnePat;
  292.     BEGIN
  293.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  294.             o.Print("Unkown Pattern number");
  295.             RETURN
  296.         END;
  297.         PatInfo:=o.Pats[PatNr];
  298.         IF o.Pats[PatNr].W<33 THEN
  299.             LastColor:=PatInfo.Next.Color;
  300.             Offset:=-32;
  301.             WHILE PatInfo.Next#NIL DO
  302.                 PatInfo:=PatInfo.Next;
  303.                 IF PatInfo.Color=LastColor THEN
  304.                     INC(Offset, 32);
  305.                 ELSE
  306.                     LastColor:=PatInfo.Color;
  307.                     IF mode=Display.replace THEN mode:=Display.paint;END;
  308.                     Offset:=0;
  309.                 END;
  310.                 IF col=OriCol THEN
  311.                     Display.ReplPattern(o.ColorMap[PatInfo.Color], PatInfo.Pat, X+Offset, Y, W, H, mode);
  312.                 ELSE
  313.                     Display.ReplPattern(col, PatInfo.Pat, X+Offset, Y, W, H, mode);
  314.                 END;
  315.             END;
  316.         ELSE
  317.             o.Print("ReplPattern can display only pattern with width <=32");
  318.             o.Print("use ReplPatternN instead");
  319.         END;
  320.     END ReplPattern;
  321.     PROCEDURE (o: Object) ReplPatternN*(f: Display.Frame; col: INTEGER; PatNr: LONGINT; X, Y, W, H, X0, Y0, mode: INTEGER);
  322.         VAR
  323.             g: Display.Frame;
  324.             DumX, DumY: INTEGER;
  325.             PatW, PatH: INTEGER;
  326.     BEGIN
  327.         IF (PatNr<0) OR (PatNr>=o.MaxPat) THEN
  328.             o.Print("Unkown Pattern number");
  329.             RETURN
  330.         END;
  331.         o.GetPatternSize(PatNr, PatW, PatH);
  332.         IF (PatW=0) OR (PatH=0) THEN RETURN;END;
  333.         NEW(g);
  334.         IF X<f.X THEN (* X in Frame ? *)
  335.             W:=W-f.X+X;
  336.             X0:=X0+f.X-X;
  337.             X:=f.X;
  338.         END;
  339.         IF Y<f.Y THEN (* Y in Frame ? *)
  340.             H:=H-f.Y+Y;
  341.             Y0:=Y0+f.Y-Y;
  342.             Y:=f.Y;
  343.         END;
  344.         IF X+W>f.X+f.W THEN (* X+W in Frame ? *)
  345.             W:=f.X+f.W-X;
  346.         END;
  347.         IF Y+H>f.Y+f.H THEN (* Y+H in Frame ? *)
  348.             H:=f.Y+f.H-Y;
  349.         END;
  350.         X0:=X0-X MOD PatW;
  351.         Y0:=Y0-Y MOD PatH;
  352.         g.X:=X;g.Y:=Y;g.W:=W;g.H:=H;
  353.         X0:=X0 MOD PatW;Y0:=Y0 MOD PatH;
  354.         IF X0#0 THEN
  355.             X0:=PatW-X0;X:=X-X0;W:=W+X0;
  356.         END;
  357.         IF Y0#0 THEN
  358.             Y0:=PatH-Y0;Y:=Y-Y0;H:=H+Y0;
  359.         END;
  360.         FOR DumX:=0 TO (W DIV PatW) DO
  361.             FOR DumY:=0 TO (H DIV PatH) DO
  362.                 o.CopyPatternC(g, col, PatNr, X+DumX*PatW, Y+DumY*PatH, mode);
  363.             END;
  364.         END;
  365.     END ReplPatternN;
  366.     PROCEDURE TextLength*(Font: Fonts.Font; Buffer: Texts.Buffer): INTEGER;
  367.         VAR
  368.             Text: Texts.Text;
  369.             DB: Texts.Buffer;
  370.             Reader: Texts.Reader;
  371.             Counter: INTEGER;
  372.             Zeichen: CHAR;
  373.             p: Display.Pattern;
  374.             dx, x, y, w, h: INTEGER;
  375.     BEGIN
  376.         Counter:=0;
  377.         NEW(DB);
  378.         Texts.OpenBuf(DB);
  379.         Texts.Copy(Buffer, DB);
  380.         Text:=TextFrames.Text("");
  381.         Texts.Append(Text, DB);
  382.         Texts.OpenReader(Reader, Text, 0);
  383.         Texts.Read(Reader, Zeichen);
  384.         WHILE (Zeichen#0DX) & (~Reader.eot) DO
  385.             Display.GetChar(Font.raster, Zeichen, dx, x, y, w, h, p);
  386.             INC(Counter, dx);
  387.             Texts.Read(Reader, Zeichen);
  388.         END;
  389.         RETURN Counter;
  390.     END TextLength;
  391.     PROCEDURE PlotText*(f: Display.Frame; col: INTEGER; F: Fonts.Font; B: Texts.Buffer; XPos, YPos, mode: INTEGER);
  392.         VAR
  393.             Text: Texts.Text;
  394.             Reader: Texts.Reader;
  395.             Zeichen: CHAR;
  396.             p: Display.Pattern;
  397.             dx, x, y, w, h: INTEGER;
  398.     BEGIN
  399.         Text:=TextFrames.Text("");
  400.         Texts.Append(Text, B);
  401.         Texts.OpenReader(Reader, Text, 0);
  402.         Texts.Read(Reader, Zeichen);
  403.         WHILE (Zeichen#0DX) & (~Reader.eot) DO
  404.             Display.GetChar(F.raster, Zeichen, dx, x, y, w, h, p);
  405.             Display.CopyPatternC(f, col, p, XPos+x, YPos+y, mode);
  406.             INC(XPos, dx);
  407.             Texts.Read(Reader, Zeichen);
  408.         END;
  409.     END PlotText;
  410. BEGIN
  411.     SetArray[0]:=1;SetArray[1]:=2;SetArray[2]:=4;SetArray[3]:=8;
  412.     SetArray[4]:=16;SetArray[5]:=32;SetArray[6]:=64;SetArray[7]:=-128;
  413.     Texts.OpenWriter(W);
  414. END DisplayPat.
  415.